home *** CD-ROM | disk | FTP | other *** search
/ Apple II Magazines (DO) / Softdisk Magazette Volume 2, No. 01 (1982-09)(Softdisk)(Side B).zip / Softdisk Magazette Volume 2, No. 01 (1982-09)(Softdisk)(Side B).do / SALYER.HELLO.bas < prev    next >
BASIC Source File  |  1996-12-24  |  4KB  |  90 lines
  1. 10  REM <CTRL-J><CTRL-J>DATE-KEEPER HELLO PROGRAM
  2. 11 MENU$ = "MENU"
  3. 12  DIM MO$(12),WE$(7),ND(12)
  4. 13 CENT = 19: REM INT(YEAR/100)
  5. 15  GOSUB 350: REM <CTRL-J><CTRL-J>INITIALIZE<CTRL-J><CTRL-J>
  6. 20 D$ =  CHR$(4): ONERR  GOTO 80
  7. 30  PRINT D$"OPEN DATE"
  8. 40  PRINT D$"READ DATE"
  9. 50  INPUT DR$
  10. 60  PRINT D$"CLOSE"
  11. 70 YR$ =  LEFT$(DR$,2):M$ =  MID$ (DR$,3,2):DA$ =  MID$ (DR$,5,2):WD$ =  RIGHT$(DR$,1)
  12. 80 YEAR = CENT *100 + VAL(YR$):MO =  VAL(M$):DA =  VAL(DA$):WD =  VAL(WD$)
  13. 90 DT$ = MO$(MO) +" " +DA$ +", " + STR$(YEAR)
  14. 100  TEXT : HOME : PRINT " DOS 3.3 MASTER";: HTAB 27: PRINT WE$(WD): HTAB (39 - LEN(DT$)): PRINT DT$: VTAB 4: POKE 34,3
  15. 110  POKE 216,0: POKE 1016, VAL(YR$): POKE 1017,MO: POKE 1018,DA: POKE 1019,WD
  16. 120  VTAB 5: PRINT " TO CHANGE DATE, PRESS 'D'"
  17. 130  VTAB 7: PRINT " FOR A CATALOG, PRESS 'C'"
  18. 140  VTAB 9: PRINT " FOR A MENU OF PROGRAMS, PRESS 'M'"
  19. 150  VTAB 11: PRINT " TO RETURN TO BASIC, PRESS ANY OTHER KEY ... ";
  20. 160  GET A$: PRINT : IF A$ = "D"  THEN 200
  21. 170  IF A$ = "M"  THEN  HOME : PRINT D$;"RUN ";MENU$: END 
  22. 180  IF A$ = "C"  THEN  HOME : PRINT D$;"CATALOG": END 
  23. 190  HOME : TEXT : VTAB 5: END 
  24. 200  HOME : INVERSE : PRINT " A <RETURN> LEAVES AS ABOVE ... ": NORMAL : PRINT : PRINT 
  25. 210  VTAB 10: PRINT "ENTER MONTH NO. (1-12) : ";:NH = 12:NL = 1: GOSUB 400: IF  LEN(A$) = 0  THEN  VTAB 10: HTAB 26: PRINT M$: GOTO 230
  26. 220 M$ =  RIGHT$(" " +A$,2):MO =  VAL(M$)
  27. 230  VTAB 13: PRINT "ENTER DAY OF MONTH (1-";ND(MO);") : ";:NH = ND(MO):NL = 1: GOSUB 400: IF  LEN(A$) = 0  THEN  VTAB 13: HTAB 29: PRINT DA$: GOTO 250
  28. 240 DA$ =  RIGHT$(" " +A$,2):DA =  VAL(DA$)
  29. 250  VTAB 16: PRINT "ENTER YEAR AS 2 DIGITS : ";CENT;:NH = 99:NL = 0: GOSUB 400: IF  LEN(A$) = 0  THEN  VTAB 16: HTAB 28: PRINT YR$: GOTO 270
  30. 260 YR$ =  RIGHT$("0" +A$,2):YEAR = CENT *100 + VAL(YR$)
  31. 270 DD$ = MO$(MO) +" " +DA$ +", " + STR$(YEAR)
  32. 280  VTAB 19: PRINT "NEW DATE IS ";DD$;" (Y/N)? ";: GET A$: PRINT A$
  33. 290  IF A$ = "N"  THEN 200
  34. 300 WD =  FN WEEKDAY(YEAR):WD$ =  STR$(WD)
  35. 310 DR$ = YR$ +M$ +DA$ +WD$
  36. 320  GOSUB 490: GOTO 80
  37. 325  REM 
  38. 330  REM ********************
  39. 331  REM *                  *
  40. 332  REM * LIMITATION OF    *
  41. 333  REM * THE PROGRAM IS   *
  42. 334  REM * THAT THE ERROR   *
  43. 335  REM * ROUTINE DOES NOT *
  44. 336  REM * KNOW ABOUT LEAP  *
  45. 337  REM * YEARS AND WILL   *
  46. 338  REM * BLINDLY ACCEPT   *
  47. 339  REM * FEB. 29 ON A NON *
  48. 340  REM * LEAP YEAR.       *
  49. 341  REM *                  *
  50. 342  REM ********************
  51. 343  REM 
  52. 350  FOR I = 1 TO 12: READ MO$(I),ND(I): NEXT I
  53. 355  DATA JANUARY,31,FEBRUARY,29,MARCH,31,APRIL,30,MAY,31,JUNE,30,JULY,31,AUGUST,31,SEPTEMBER,30,OCTOBER,31,NOVEMBER,30,DECEMBER,31
  54. 360  FOR I = 0 TO 6: READ WE$(I): NEXT I
  55. 365  DATA  SUNDAY,MONDAY,TUESDAY,WEDNESDAY,THURSDAY,FRIDAY,SATURDAY 
  56. 370  DEF  FN WEEKDAY(YEAR) =  FN W(N) +( INT( - FN W(N)/7) *7) +6
  57. 380  DEF  FN W(N) = (MO <3) *(365 *YE +DA +31 *(MO -1) + INT((YE -1)/4) - INT(3/4 *( INT((YE -1)/100) +1))) +(MO >2) *(365 *YE +DA +31 *(MO -1) - INT(.4 *MO +2.3) + INT(YE/4) - INT(3/4 *( INT(YE/100) +1)))
  58. 390  RETURN 
  59. 395  REM <CTRL-J><CTRL-J>ERROR CHECK ROUTINE<CTRL-J><CTRL-J>
  60. 400 VT =  PEEK(37):HT =  PEEK(36): CALL  -868: INPUT "";A$: IF  LEN(A$) = 0  THEN 430
  61. 410 V =  VAL(A$): IF V < = NH  AND V > = NL  THEN 430
  62. 420  VTAB VT +3: INVERSE : PRINT " MUST BE BETWEEN ";NL;" AND ";NH;" ": NORMAL : FOR X = 1 TO 1600: NEXT X: VTAB VT +3: CALL  -868: VTAB VT +1: HTAB HT +1: GOTO 400
  63. 430  RETURN 
  64. 450  REM <CTRL-J><CTRL-J>SAVE DATE FILE<CTRL-J><CTRL-J>
  65. 490  PRINT D$"UNLOCK DATE"
  66. 500  PRINT D$"OPEN DATE"
  67. 510  PRINT D$"WRITE DATE"
  68. 520  PRINT DR$
  69. 530  PRINT D$"CLOSE"
  70. 540  PRINT D$"LOCK DATE"
  71. 550  RETURN 
  72. 65535  REM <CTRL-J><CTRL-J>THE DATE IS SAVED        IN LOCATIONS 1016 -         1019, AS FOLLOWS:
  73. 65535  REM <CTRL-J>YEAR (0-99) IN 1016        MONTH (1-12) IN 1017         DATE (1-31) IN 1018          DAY (0-6)  IN 1019
  74. 65535  REM <CTRL-J><CTRL-J>DAY IS A CODE FOR           THE WEEKDAY WITH            0 BEING SUNDAY AND          6 BEING SATURDAY.
  75. 65535  REM 
  76. 65535  REM *******************
  77. 65535  REM * WRITTEN BY:     *
  78. 65535  REM * DALE E. SALYER  *
  79. 65535  REM * THORNTON, COLO. *
  80. 65535  REM * ORIGINAL IDEA - *
  81. 65535  REM * APPEARED IN:    *
  82. 65535  REM * NIBBLE VOL. 2   *
  83. 65535  REM * NO. 5, PG. 79   *
  84. 65535  REM * BY: DON RAVEY   *
  85. 65535  REM * DATE FUNCTIONS  *
  86. 65535  REM *FROM PROGRAMMERS *
  87. 65535  REM * LIBRARY FROM:   *
  88. 65535  REM * TELEPHONE SOFT- *
  89. 65535  REM * WARE CONNECTION *
  90. 65535  REM *******************